perm filename PRESCN.OLD[NEW,LCS] blob sn#209701 filedate 1977-12-14 generic text, type T, neo UTF8
32600		SUBROUTINE PRESCN
32700	C  THIS SORTS OUT NEW INPUT FORMAT - CREATES OLD STYLE.
32740		COMMON/SCX/RHY(4),JALPHA(30),J4,L,Y,K,RX,RZ,RA,J5
32750		COMMON/SCN/LL,LR,LU,LD,LSL,LE,LC,LS,LF,LA,LI,LW
32775		DATA LL/'L'/,LR/'R'/,LU/'U'/,LD/'D'/,LE/'E'/
32787		1,LC/'C'/,LS/'S'/,LF/'F'/,LA/'A'/,LI/'I'/,LW/'W'/
32800		DIMENSION IR(1)
32900		COMMON/ALF/INP(72),M/XRN/RN(4000)
33000		EQUIVALENCE (IR,RN(2001)),(LCM,JALPHA),(LBL,JALPHA(12))
33050		1,(LST,ALPHA(8))
33100	C  CHECK THIS EQUIV.↑↑↑↑
33200	100	IF(ISM)5,55,555
33300	C  -1=PROCESS SOME MORE, 0=1ST TIME, 1=PUT OUT RHYTH
33350	C  !!!!! DON'T STOP IN THE MIDDLE!!!  ISM MUST BE 0 FIRST TIME!!!!
33400	55	JX=0
33500	5	K=0
33600		J=0
33700		I=JX
33800		JX=JX+72
33900	1	K=K+1
34000		M=INP(K)
34100	15	IF(M.EQ.LBL)GO TO 1
34150		IF(M.EQ.LCM)GO TO 1
34200	C  REMOVE BLANKS AND COMMAS
34300		JN=0
34400		IF(M.LT.'0')GO TO 677
34450		IF(M.LE.'9')GO TO 2
34500	677	MM=INP(K+1)
34710	3	IF(M.EQ.'P')GO TO 8
34720		IF(M.EQ.'O')GO TO 8
34730		IF(M.LT.LA)GO TO 777
34740		IF(M.GT.'G')GO TO 777
34750		IF(MM.EQ.LL)GO TO 777
34760		IF(MM.NE.LA)GO TO 8
34800	C  FINDS NOTES, PROX., AND ORDINARY, -- NOT 'BA' OR 'AL'
34900	777	IF(M.NE.LR)GO TO 9
35000		IF(MM.EQ.LE)JN=1
35100	C  CATCHES 'R' 'RI' 'REP'
35200		GO TO 8
35300	9	IF(M.EQ.LSL)GO TO 8
35310		IF(M.EQ.';')GO TO 8
35320		IF(M.EQ.LST)GO TO 8
35330		IF(M.EQ.':')GO TO 8
35400		JN=-1
35500	8	J=J+1
35600		 INP(J)=M
35700		IF(M.EQ.'X')JN=1
35800	C  PICKS UP 4X ETC. FOR BOTH NOTES AND RHYTH.
35900		IF(JN.LE.0)GO TO 13
36000	C  PUTS 'REP' INTO RHYTH ALSO
36100		I=I+1
36200		IR(I)=M
36300	13	IF(M.EQ.LSL)GO TO 4
36310		IF(M.EQ.';')GO TO 4
36320		IF(M.EQ.LST)GO TO 4
36400		K=K+1
36500		M=INP(K)
36600		GO TO 8
36700	
36800	4	IF(JN.NE.0)GO TO 7
36900		I=I+1
37000		IR(I)=M
37100	7	IF(M.EQ.LSL)GO TO 1
37200		IF(M.EQ.';')GO TO 11
37300		IF(M.EQ.LST)GO TO 6
37400	
37500	2	I=I+1
37600		IR(I)=M
37700		K=K+1
37800		M=INP(K)
37900		IF(M.EQ.'.')GO TO 2
37910		IF(M.LT.'0')GO TO 15
37920		IF(M.LE.'9')GO TO 2
38000	C  NO BLANK NEEDED AFTER RHYTH.( /4.AS3/8/ ETC.)
38100		GO TO 15
38200	
38300	11	IF(IR(I).NE.';')IR(I)=';'
38400		ISM=-1
38500		RETURN
38600	C  WE'LL COME BACK FOR MORE.
38700	
38800	6	IF(IR(I).NE.LST)IR(I)=LST
38900		JX=0
39000		ISM=1
39100	C AFTER THIS WE USE RHYTJ DATA.
39200		RETURN
39300	
39400	555	DO 12 K=1,72
39500		M=IR(K+JX)
39600		INP(K)=M
39700		IF(M.EQ.';')GO TO 10
39800	C  MORE THAN ONE LINE
39900	12	IF(M.EQ.LST)GO TO 14
40000	10	JX=JX+72
40100	C  MOVE TO THE NEXT 'LINE'
40200		RETURN
40300	14	ISM=0
40400		END